home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / msm-1 / icont.sit / tsym.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-09-19  |  12.1 KB  |  515 lines  |  [TEXT/MPS ]
  1. /*
  2.  * tsym.c -- functions for symbol table management.
  3.  */
  4.  
  5. #include "::h:gsupport.h"
  6. #include "tproto.h"
  7. #include "globals.h"
  8. #include "trans.h"
  9. #include "token.h"
  10. #include "tsym.h"
  11.  
  12. #ifndef VarTran
  13. #include "lfile.h"
  14. #endif                    /* VarTran */
  15.  
  16. /*
  17.  * Prototypes.
  18.  */
  19.  
  20. hidden struct    tgentry *alcglob
  21.    Params((struct tgentry *blink, char *name,int flag,int nargs));
  22. hidden struct    tcentry *alclit    
  23.    Params((struct tcentry *blink, char *name, int len,int flag));
  24. hidden struct    tlentry *alcloc    
  25.    Params((struct tlentry *blink, char *name,int flag));
  26. hidden struct    tcentry *clookup    Params((char *id,int flag));
  27. hidden struct    tgentry *glookup    Params((char *id));
  28. hidden struct    tlentry *llookup    Params((char *id));
  29. hidden novalue    putglob
  30.    Params((char *id,int id_type, int n_args));
  31.  
  32. #ifdef DeBugTrans
  33. novalue    cdump    Params((noargs));
  34. novalue    gdump    Params((noargs));
  35. novalue    ldump    Params((noargs));
  36. #endif                    /* DeBugTrans */
  37.  
  38. #ifdef Xver
  39. xver(tsym.1)
  40. #endif                    /* Xver */
  41.  
  42. #ifndef VarTran
  43.  
  44. /*
  45.  * loc_init - clear the local and constant symbol tables.
  46.  */
  47.  
  48. novalue loc_init()
  49.    {
  50.    struct tlentry *lptr, *lptr1;
  51.    struct tcentry *cptr, *cptr1;
  52.    int i;
  53.  
  54.    /*
  55.     * Clear local table, freeing entries.
  56.     */
  57.    for (i = 0; i < lhsize; i++) {
  58.       for (lptr = lhash[i]; lptr != NULL; lptr = lptr1) {
  59.           lptr1 = lptr->l_blink;
  60.           free((char *)lptr);
  61.           }
  62.        lhash[i] = NULL;
  63.        }
  64.    lfirst = NULL;
  65.    llast = NULL;
  66.  
  67.    /*
  68.     * Clear constant table, freeing entries.
  69.     */
  70.    for (i = 0; i < chsize; i++) {
  71.       for (cptr = chash[i]; cptr != NULL; cptr = cptr1) {
  72.           cptr1 = cptr->c_blink;
  73.           free((char *)cptr);
  74.           }
  75.        chash[i] = NULL;
  76.        }
  77.    cfirst = NULL;
  78.    clast = NULL;
  79.    }
  80.  
  81. /*
  82.  * install - put an identifier into the global or local symbol table.
  83.  *  The basic idea here is to look in the right table and install
  84.  *  the identifier if it isn't already there.  Some semantic checks
  85.  *  are performed.
  86.  */
  87. novalue install(name, flag, argcnt)
  88. char *name;
  89. int flag, argcnt;
  90.    {
  91.    union {
  92.       struct tgentry *gp;
  93.       struct tlentry *lp;
  94.       } p;
  95.  
  96.    switch (flag) {
  97.       case F_Global:    /* a variable in a global declaration */
  98.          if ((p.gp = glookup(name)) == NULL)
  99.             putglob(name, flag, argcnt);
  100.          else
  101.             p.gp->g_flag |= flag;
  102.          break;
  103.  
  104.       case F_Proc|F_Global:    /* procedure declaration */
  105.       case F_Record|F_Global:    /* record declaration */
  106.       case F_Builtin|F_Global:    /* external declaration */
  107.          if ((p.gp = glookup(name)) == NULL)
  108.             putglob(name, flag, argcnt);
  109.          else if ((p.gp->g_flag & (~F_Global)) == 0) { /* superfluous global
  110.                                declaration for
  111.                                record or proc */
  112.             p.gp->g_flag |= flag;
  113.             p.gp->g_nargs = argcnt;
  114.             }
  115.          else            /* the user can't make up his mind */
  116.             tfatal("inconsistent redeclaration", name);
  117.          break;
  118.  
  119.       case F_Static:    /* static declaration */
  120.       case F_Dynamic:    /* local declaration (possibly implicit?) */
  121.       case F_Argument:    /* formal parameter */
  122.          if ((p.lp = llookup(name)) == NULL)
  123.             putloc(name,flag);
  124.          else if (p.lp->l_flag == flag) /* previously declared as same type */
  125.             tfatal("redeclared identifier", name);
  126.          else        /* previously declared as different type */
  127.             tfatal("inconsistent redeclaration", name);
  128.          break;
  129.  
  130.       default:
  131.          tsyserr("install: unrecognized symbol table flag.");
  132.       }
  133.    }
  134.  
  135. /*
  136.  * putloc - make a local symbol table entry and return the index
  137.  *  of the entry in lhash.  alcloc does the work if there is a collision.
  138.  */
  139. int putloc(id,id_type)
  140. char *id;
  141. int id_type;
  142.    {
  143.    register struct tlentry *ptr;
  144.  
  145.    if ((ptr = llookup(id)) == NULL) {    /* add to head of hash chain */
  146.       ptr = lhash[lhasher(id)];
  147.       lhash[lhasher(id)] = alcloc(ptr, id, id_type);
  148.       return lhash[lhasher(id)]->l_index;
  149.       }
  150.    return ptr->l_index;
  151.    }
  152.  
  153. /*
  154.  * putglob makes a global symbol table entry. alcglob does the work if there
  155.  *  is a collision.
  156.  */
  157.  
  158. static novalue putglob(id, id_type, n_args)
  159. char *id;
  160. int id_type, n_args;
  161.    {
  162.    register struct tgentry *ptr;
  163.  
  164.    if ((ptr = glookup(id)) == NULL) {     /* add to head of hash chain */
  165.       ptr = ghash[ghasher(id)];
  166.       ghash[ghasher(id)] = alcglob(ptr, id, id_type, n_args);
  167.       }
  168.    }
  169.  
  170. /*
  171.  * putlit makes a constant symbol table entry and returns the table "index"
  172.  *  of the constant.  alclit does the work if there is a collision.
  173.  */
  174. int putlit(id, idtype, len)
  175. char *id;
  176. int len, idtype;
  177.    {
  178.    register struct tcentry *ptr;
  179.  
  180.    if ((ptr = clookup(id,idtype)) == NULL) {   /* add to head of hash chain */
  181.       ptr = chash[chasher(id)];
  182.       chash[chasher(id)] = alclit(ptr, id, len, idtype);
  183.       return chash[chasher(id)]->c_index;
  184.       }
  185.    return ptr->c_index;
  186.    }
  187.  
  188. /*
  189.  * llookup looks up id in local symbol table and returns pointer to
  190.  *  to it if found or NULL if not present.
  191.  */
  192.  
  193. static struct tlentry *llookup(id)
  194. char *id;
  195.    {
  196.    register struct tlentry *ptr;
  197.  
  198.    ptr = lhash[lhasher(id)];
  199.    while (ptr != NULL && ptr->l_name != id)
  200.       ptr = ptr->l_blink;
  201.    return ptr;
  202.    }
  203.  
  204. /*
  205.  * glookup looks up id in global symbol table and returns pointer to
  206.  *  to it if found or NULL if not present.
  207.  */
  208. static struct tgentry *glookup(id)
  209. char *id;
  210.    {
  211.    register struct tgentry *ptr;
  212.  
  213.    ptr = ghash[ghasher(id)];
  214.    while (ptr != NULL && ptr->g_name != id) {
  215.       ptr = ptr->g_blink;
  216.       }
  217.    return ptr;
  218.    }
  219.  
  220. /*
  221.  * clookup looks up id in constant symbol table and returns pointer to
  222.  *  to it if found or NULL if not present.
  223.  */
  224. static struct tcentry *clookup(id,flag)
  225. char *id;
  226. int flag;
  227.    {
  228.    register struct tcentry *ptr;
  229.  
  230.    ptr = chash[chasher(id)];
  231.    while (ptr != NULL && (ptr->c_name != id || ptr->c_flag != flag))
  232.       ptr = ptr->c_blink;
  233.  
  234.    return ptr;
  235.    }
  236.  
  237. /*
  238.  * klookup looks up keyword named by id in keyword table and returns
  239.  *  its number (keyid).
  240.  */
  241. int klookup(id)
  242. register char *id;
  243.    {
  244.    register struct keyent *kp;
  245.  
  246.    for (kp = keytab; kp->keyid >= 0; kp++)
  247.       if (strcmp(kp->keyname,id) == 0)
  248.          return (kp->keyid);
  249.  
  250.    return 0;
  251.    }
  252.  
  253. #ifdef DeBugTrans
  254. /*
  255.  * ldump displays local symbol table to stdout.
  256.  */
  257.  
  258. novalue ldump()
  259.    {
  260.    register int i;
  261.    register struct tlentry *lptr;
  262.    int n;
  263.  
  264.    if (llast == NULL)
  265.       n = 0;
  266.    else
  267.       n = llast->l_index + 1;
  268.    fprintf(stderr,"Dump of local symbol table (%d entries)\n", n);
  269.    fprintf(stderr," loc   blink   id          (name)      flags\n");
  270.    for (i = 0; i < lhsize; i++)
  271.       for (lptr = lhash[i]; lptr != NULL; lptr = lptr->l_blink)
  272.          fprintf(stderr,"%5d  %5d  %5d    %20s  %7o\n", lptr->l_index,
  273.         lptr->l_blink, lptr->l_name, lptr->l_name, lptr->l_flag);
  274.    fflush(stderr);
  275.  
  276.    }
  277.  
  278. /*
  279.  * gdump displays global symbol table to stdout.
  280.  */
  281.  
  282. novalue gdump()
  283.    {
  284.    register int i;
  285.    register struct tgentry *gptr;
  286.    int n;
  287.  
  288.    if (glast == NULL)
  289.       n = 0;
  290.    else
  291.       n = glast->g_index + 1;
  292.    fprintf(stderr,"Dump of global symbol table (%d entries)\n", n));
  293.    fprintf(stderr," loc   blink   id          (name)      flags      nargs\n");
  294.    for (i = 0; i < ghsize; i++)
  295.       for (gptr = ghash[i]; gptr != NULL; gptr = gptr->g_blink)
  296.          fprintf(stderr,"%5d  %5d  %5d    %20s  %7o   %8d\n", gptr->g_index,
  297.         gptr->g_blink, gptr->g_name, gptr->g_name,
  298.         gptr->g_flag, gptr->g_nargs);
  299.    fflush(stderr);
  300.    }
  301.  
  302. /*
  303.  * cdump displays constant symbol table to stdout.
  304.  */
  305.  
  306. novalue cdump()
  307.    {
  308.    register int i;
  309.    register struct tcentry *cptr;
  310.    int n;
  311.  
  312.    if (clast == NULL)
  313.       n = 0;
  314.    else
  315.       n = clast->c_index + 1;
  316.    fprintf(stderr,"Dump of constant symbol table (%d entries)\n", n);
  317.    fprintf(stderr," loc   blink   id          (name)      flags\n");
  318.    for (i = 0; i < chsize; i++)
  319.       for (cptr = chash[i]; cptr != NULL; cptr = cptr->c_blink)
  320.          fprintf(stderr,"%5d  %5d  %5d    %20s  %7o\n", cptr->c_index,
  321.         cptr->c_blink, cptr->c_name, cptr->c_name, cptr->c_flag);
  322.    fflush(stderr);
  323.    }
  324. #endif                    /* DeBugTrans */
  325.  
  326. /*
  327.  * alcloc allocates a local symbol table entry, fills in fields with
  328.  *  specified values and returns the new entry.  
  329.  */
  330. static struct tlentry *alcloc(blink, name, flag)
  331. struct tlentry *blink;
  332. char *name;
  333. int flag;
  334.    {
  335.    register struct tlentry *lp;
  336.  
  337.    lp = NewStruct(tlentry);
  338.    lp->l_blink = blink;
  339.    lp->l_name = name;
  340.    lp->l_flag = flag;
  341.    lp->l_next = NULL;
  342.    if (lfirst == NULL) {
  343.       lfirst = lp;
  344.       lp->l_index = 0;
  345.       }
  346.    else {
  347.       llast->l_next = lp;
  348.       lp->l_index = llast->l_index + 1;
  349.       }
  350.    llast = lp;
  351.    return lp;
  352.    }
  353.  
  354. /*
  355.  * alcglob allocates a global symbol table entry, fills in fields with
  356.  *  specified values and returns offset of new entry.  
  357.  */
  358. static struct tgentry *alcglob(blink, name, flag, nargs)
  359. struct tgentry *blink;
  360. char *name;
  361. int flag, nargs;
  362.    {
  363.    register struct tgentry *gp;
  364.  
  365.    gp = NewStruct(tgentry);
  366.    gp->g_blink = blink;
  367.    gp->g_name = name;
  368.    gp->g_flag = flag;
  369.    gp->g_nargs = nargs;
  370.    gp->g_next = NULL;
  371.    if (gfirst == NULL) {
  372.       gfirst = gp;
  373.       gp->g_index = 0;
  374.       }
  375.    else {
  376.       glast->g_next = gp;
  377.       gp->g_index = glast->g_index + 1;
  378.       }
  379.    glast = gp;
  380.    return gp;
  381.    }
  382.  
  383. /*
  384.  * alclit allocates a constant symbol table entry, fills in fields with
  385.  *  specified values and returns the new entry.  
  386.  */
  387. static struct tcentry *alclit(blink, name, len, flag)
  388. struct tcentry *blink;
  389. char *name;
  390. int len, flag;
  391.    {
  392.    register struct tcentry *cp;
  393.  
  394.    cp = NewStruct(tcentry);
  395.    cp->c_blink = blink;
  396.    cp->c_name = name;
  397.    cp->c_length = len;
  398.    cp->c_flag = flag;
  399.    cp->c_next = NULL;
  400.    if (cfirst == NULL) {
  401.       cfirst = cp;
  402.       cp->c_index = 0;
  403.       }
  404.    else {
  405.       clast->c_next = cp;
  406.       cp->c_index = clast->c_index + 1;
  407.       }
  408.    clast = cp;
  409.    return cp;
  410.    }
  411.  
  412. /*
  413.  * lout dumps local symbol table to fd, which is a .u1 file.
  414.  */
  415. novalue lout(fd)
  416. FILE *fd;
  417.    {
  418.    register struct tlentry *lp;
  419.  
  420.    for (lp = lfirst; lp != NULL; lp = lp->l_next)
  421.       writecheck(fprintf(fd, "\tlocal\t%d,%06o,%s\n",
  422.          lp->l_index, lp->l_flag, lp->l_name));
  423.    }
  424.  
  425. /*
  426.  * cout dumps constant symbol table to fd, which is a .u1 file.
  427.  */
  428. novalue cout(fd)
  429. FILE *fd;
  430.    {
  431.    register int l;
  432.    register char *c;
  433.    register struct tcentry *cp;
  434.  
  435.    for (cp = cfirst; cp != NULL; cp = cp->c_next) {
  436.       writecheck(fprintf(fd, "\tcon\t%d,%06o", cp->c_index, cp->c_flag));
  437.       if (cp->c_flag & F_IntLit)
  438.          writecheck(fprintf(fd, ",%d,%s\n", strlen(cp->c_name), cp->c_name));
  439.       else if (cp->c_flag & F_RealLit)
  440.          writecheck(fprintf(fd, ",%s\n", cp->c_name));
  441.       else {
  442.          c = cp->c_name;
  443.          l = cp->c_length - 1;
  444.          writecheck(fprintf(fd, ",%d", l));
  445.          while (l--)
  446.             writecheck(fprintf(fd, ",%03o", *c++ & 0377));
  447.          writecheck(putc('\n', fd));
  448.          }
  449.       }
  450.    }
  451.  
  452. /*
  453.  * rout dumps a record declaration for name to file fd, which is a .u2 file.
  454.  */
  455. novalue rout(fd,name)
  456. FILE *fd;
  457. char *name;
  458.    {
  459.    register struct tlentry *lp;
  460.    int n;
  461.  
  462.    if (llast == NULL)
  463.       n = 0;
  464.    else
  465.       n = llast->l_index + 1;
  466.    writecheck(fprintf(fd, "record\t%s,%d\n", name, n));
  467.    for (lp = lfirst; lp != NULL; lp = lp->l_next)
  468.       writecheck(fprintf(fd, "\t%d,%s\n", lp->l_index, lp->l_name));
  469.    }
  470.  
  471. /*
  472.  * gout writes various items to fd, which is a .u2 file.  These items
  473.  *  include: implicit status, tracing activation, link directives,
  474.  *  and the global table.
  475.  */
  476. novalue gout(fd)
  477. FILE *fd;
  478.    {
  479.    register char *name;
  480.    register struct tgentry *gp;
  481.    int n;
  482.    struct lfile *lfl;
  483.    
  484.    if (uwarn)
  485.       name = "error";
  486.    else
  487.       name = "local";
  488.    writecheck(fprintf(fd, "impl\t%s\n", name));
  489.    if (trace)
  490.       writecheck(fprintf(fd, "trace\n"));
  491.    
  492.    lfl = lfiles;
  493.    while (lfl) {
  494.  
  495. #if MVS
  496.       writecheck(fprintf(fd,"link\t%s\n",lfl->lf_name));
  497. #else                    /* MVS */
  498.       writecheck(fprintf(fd,"link\t%s.u1\n",lfl->lf_name));
  499. #endif                    /* MVS */
  500.  
  501.       lfl = lfl->lf_link;
  502.       }
  503.    lfiles = 0;
  504.  
  505.    if (glast == NULL)
  506.       n = 0;
  507.    else
  508.       n = glast->g_index + 1;
  509.    writecheck(fprintf(fd, "global\t%d\n", n));
  510.    for (gp = gfirst; gp != NULL; gp = gp->g_next)
  511.       writecheck(fprintf(fd, "\t%d,%06o,%s,%d\n", gp->g_index, gp->g_flag,
  512.          gp->g_name, gp->g_nargs));
  513.    }
  514. #endif                    /* VarTran */
  515.